home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / MacQForth 1.0 / source / QF Source / QF.REGWRDS2.S < prev    next >
Text File  |  1995-03-06  |  10KB  |  158 lines
  1.  
  2. ********************************
  3. * Start regular words 2
  4. ********************************
  5.  
  6. *
  7. * Word "abs" - return absolute value of top stack item
  8. *
  9.  
  10. WORD63 ASC 'abs '
  11.  DW ABS
  12.  
  13. ABS JSR POPDATA
  14.  TXA
  15.  BPL GLOB_PUSH
  16.  
  17. NEGATSUB TYA
  18.  EOR #$FF
  19.  CLC
  20.  ADC #01
  21.  TAY
  22.  TXA
  23.  EOR #$FF
  24.  ADC #00
  25.  TAX
  26.  
  27. GLOB_PUSH JMP PUSHDATA
  28.  
  29. *
  30. * Word "negate" - negate top value on stack
  31. *
  32.  
  33. WORD64 ASC 'negate '
  34.  DW NEGATE
  35.  
  36. NEGATE JSR POPDATA
  37.  BRA NEGATSUB
  38.  
  39. *
  40. * Word "<" - comparison operator
  41. *
  42.  
  43. WORD65 ASC '< '
  44.  DW LESSTHAN
  45.  
  46. LESSTHAN JSR POPDATA ; Fetch first signed integer
  47.  STY PNTR
  48.  STX PNTR+1
  49.  
  50.  JSR POPDATA ; Fetch second signed integer
  51.  
  52.  TXA ; Actual comparison done here
  53.  EOR PNTR+1
  54.  AND #$80
  55.  BEQ :SAMESGN
  56.  
  57.  TXA
  58.  BMI :TRUE
  59.  BRA :FALSE
  60.  
  61. :SAMESGN CPX PNTR+1
  62.  BNE :NOCHKLO
  63.  CPY PNTR
  64. :NOCHKLO BCC :TRUE
  65.  
  66. :FALSE LDY #$00
  67.  LDX #$00
  68.  JMP PUSHDATA
  69.  
  70. :TRUE LDY #$FF
  71.  LDX #$FF
  72.  JMP PUSHDATA
  73.  
  74. *
  75. * Word ">" - comparison operator
  76. *
  77.  
  78. WORD66 ASC '> '
  79.  DW MORETHAN
  80.  
  81. MORETHAN JSR POPDATA ; Fetch first signed integer
  82.  STY PNTR
  83.  STX PNTR+1
  84.  
  85.  JSR POPDATA ; Fetch second signed integer
  86.  
  87.  TXA ; Actual comparison done here
  88.  EOR PNTR+1
  89.  AND #$80
  90.  BEQ :SAME
  91.  
  92.  TXA
  93.  BPL :TRUE
  94.  BRA :FALSE
  95.  
  96. :SAME CPX PNTR+1
  97.  BNE :NOCHKLO
  98.  CPY PNTR
  99. :NOCHKLO BCC :FALSE
  100.  BEQ :FALSE
  101.  
  102. :TRUE LDY #$FF
  103.  LDX #$FF
  104.  JMP PUSHDATA
  105.  
  106. :FALSE LDY #$00
  107.  LDX #$00
  108.  JMP PUSHDATA
  109.  
  110. *
  111. * Word "=" - comparison operator
  112. *
  113. * Note: bypasses POPDATA, PUSHDATA for speed
  114. *
  115.  
  116. WORD67 ASC '= '
  117.  DW EQUAL
  118.  
  119. EQUAL LDA DATITEMS ; Make sure there's at least
  120.  CMP #02 ;   two items on stack
  121.  BCC :ERROR
  122.  
  123.  LDY DATSTACK
  124.  LDA DATAAREA+1,Y
  125.  CMP DATAAREA+3,Y
  126.  BNE :FALSE
  127.  LDA DATAAREA+2,Y
  128.  CMP DATAAREA+4,Y
  129.  BNE :FALSE
  130.  
  131.  LDA #$FF
  132.  HEX 2C
  133. :FALSE LDA #00
  134.  STA DATAAREA+3,Y
  135.  STA DATAAREA+4,Y
  136.  
  137.  INY ; Adjust data stack pointer
  138.  INY
  139.  STY DATSTACK
  140.  
  141. :SKIPINC DEC DATITEMS ; Adjust data items pointer
  142.  RTS
  143.  
  144. :ERROR LDA #04 ; "Data stack underflow"
  145.  JMP PRTERR
  146.  
  147. *
  148. * Word "<>" - comparison operator
  149. *
  150. * Note: bypasses POPDATA, PUSHDATA for speed
  151. *
  152.  
  153. WORD68 ASC '<> '
  154.  DW NOTEQUAL
  155.  
  156. NOTEQUAL LDA DATITEMS ; Make sure there's at least
  157.  CMP #02 ;   two items on stack
  158.  BC